;; =============================================================================
;; introduces processing context

(in-package :oali.core)

;; =============================================================================
;; encloses core language entities that are applicable for any
;; ANSI ISO C99 - compliant C compiler
(defclass p-core-context ()
  (
   ;;
   ;; qualifiers
   ))




;; =============================================================================
;; add builtin types for 32-bit compiler
(defun add-builtin-types-32bit (add-builtin)
  (flet ((add (type-id type-name type-size)
	   (funcall add-builtin type-id type-name type-size)))

    ;; add builtin types
    (add 'char "char" 1)
    (add 'short "short" 2)
    (add 'int "int" 4)
    (add 'long "long" 4)
    (add 'float "float" 4)
    (add 'double "double" 8)
    (add 'longlong "long long" 8)))


;; =============================================================================
;; create base type map
(defun create-types-map ()
  (let ((types-map (make-hash-table)))
    ;; functions provided for convenience
    (flet ((add-type (type-id type-inst)
             (setf (gethash type-id types-map) type-inst))
           
           ;; local function that retrieves type object by id
           (get-type (type-id) (let ((result (gethash type-id types-map)))
				 (unless result (error (format nil "undeclared ~a" type-id)))
				 result)))

      ;; add builtin types
      (flet ((add (type-id type-name type-size)
	       (setf (gethash type-id types-map)
		     (make-instance 'p-type-builtin :name type-name :size type-size))))
	;; first add void type that is common for all the compilers
	(add 'void "void" 0)

	;; add builtin types (int, char, etc.)
	(add-builtin-types-32bit #'add))

      ;; add types for convenience
      (if t
          (progn
            ;; signed types
            (flet ((add (type-id sign-spec inferior-type-id)
                     (add-type type-id (make-instance 'p-qualified-type
                                                      :inferior-type (get-type inferior-type-id)
                                                      :qualifier sign-spec))))
              (let ((signed 'signed)
                    (unsigned 'unsigned))
                (add 'sint signed 'int)
                (add 'uint unsigned 'int)
                (add 'uchar unsigned 'char)
                (add 'ulonglong unsigned 'longlong)))

            ;; pointer types
            (flet ((add (type-id pointee-type-id)
                     (add-type type-id
			       (make-instance 'p-type-pointer
					      :pointee-type (get-type pointee-type-id)))))
              (add 'void-p 'void)
              (add 'char-p 'char)
              (add 'char-pp 'char-p)
              (add 'uchar-p 'uchar)
              (add 'uint-p 'uint))
            ))

      ;; return types map
      types-map)))



;; =============================================================================
;; core context
(defclass p-context (p-core-context)
  (
   ;; types table
   (types :accessor types)

   ;; functions table
   (funcs :accessor funcs)

   ;; accessible variables
   (vars :accessor vars :initform nil)

   (current-func :accessor current-func :initform nil)
   ))

;; =============================================================================
;; context constructor
(defun create-context ()
  (let ((context (make-instance 'p-context)))
    (setf (types context) (create-types-map))
    (setf (funcs context) (make-hash-table))
    context))
